home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / mvpforth.arc / MVPDOS.FTH < prev    next >
Text File  |  1984-01-08  |  17KB  |  515 lines
  1. \ .B CARRAY ARRAY STRING                              01Nov83RSW
  2.                 DECIMAL
  3. : .B BASE @ DUP ." Now in base " DECIMAL . CR BASE ! ;
  4.  
  5. : CARRAY ( # bytes --- )  ( # --- addr )
  6.          CREATE 1+ ALLOT DOES> + ;
  7.  
  8. : ARRAY  ( # words --- )  ( # --- addr )
  9.          CREATE 1+ 2* ALLOT DOES> SWAP 2* + ;
  10.  
  11. : STRING  ( N-MAX --> )
  12.    CREATE 1 MAX 255 MIN
  13.     DUP C, 0 C, ALLOT
  14.    DOES> 1+ COUNT ;
  15.  
  16.  
  17. \ FLEN  return length of a string                     06Nov83RSW
  18.         DECIMAL
  19.  
  20. : FLEN ( addr --- count ) \  return length of string
  21.  255 0
  22.  DO
  23.    DUP I +
  24.    C@ 0=
  25.    IF
  26.      I LEAVE
  27.    THEN
  28.  LOOP
  29.  SWAP DROP ;
  30.  
  31.  
  32.  
  33. \ ACCEPT LEN MLEN S! string manipulation stuff        06Nov83RSW
  34.         FORTH DEFINITIONS DECIMAL
  35. : ACCEPT  (S string --- ) \ transfer chars from term to string
  36.    DROP 1- DUP 1- @ OVER 1+ DUP ROT ( addr-1 addr addr n --- )
  37.    EXPECT
  38.    FLEN
  39.    SWAP C! ;
  40.  
  41. : LEN   SWAP DROP ; (S string --- string-current-length )
  42. : MLEN  DROP 2- C@ ; (S string --- string-max-length )
  43.  
  44. : S!  (S string1 string2 --- ) \ stores string1 into string2
  45.    DROP DUP 2- C@
  46.    ROT MIN DUP 3 PICK 1- C! CMOVE ;
  47.  
  48.  
  49. \ <"> " ILINE NULL$      string manipulation stuff    06Nov83RSW
  50.  
  51. : <">
  52.     R@ COUNT DUP 1+ R> + >R ;
  53.         HEX
  54. : "
  55.    22   \ push terminator " onto stack
  56.    STATE @ IF
  57.         COMPILE <"> WORD C@ 1+ ALLOT
  58.    ELSE
  59.         TEXT PAD COUNT
  60.    THEN ;  IMMEDIATE   DECIMAL
  61.  
  62.  
  63. 82 STRING ILINE
  64. 0 STRING NULL$
  65. \ MID$ RIGHT$ LEFT$ VAL CHR$ ASC SUB!                 06Nov83RSW
  66.         DECIMAL
  67. : MID$
  68.     >R OVER MIN 1 MAX 1-
  69.     SWAP OVER - R> MIN >R + R> ;
  70. : RIGHT$
  71.     OVER 1+ SWAP - 255 MID$ ;
  72. : LEFT$
  73.     1 SWAP MID$ ;
  74. : VAL
  75.     >R PAD 1+ R@ CMOVE R@ PAD C!
  76.     0 PAD 1+ R> + C!
  77.     PAD NUMBER ;
  78. : CHR$  PAD ! PAD 1 ;
  79. : ASC  DROP C@ ;
  80. : SUB!  ROT MIN 0 MAX CMOVE ;
  81. \ S= compare two strings for equality                 06Nov83RSW
  82.  
  83. : S=
  84.    ROT OVER = IF
  85.      ?DUP IF
  86.        1 SWAP 0 DO
  87.          DROP OVER C@ OVER C@ = IF
  88.            1+ SWAP 1+ SWAP 1
  89.          ELSE 0 LEAVE
  90.          THEN
  91.        LOOP
  92.      ELSE 1
  93.      THEN
  94.    ELSE DROP 0
  95.    THEN
  96.    SWAP DROP SWAP DROP ;
  97. \ S<                                                  06Nov83RSW
  98.  
  99. : S<
  100.    ROT OVER MIN SWAP OVER > >R ?DUP IF
  101.      -1 SWAP 0 DO
  102.        DROP OVER C@ OVER C@ = IF
  103.          1+ SWAP 1+ SWAP -1
  104.        ELSE C@ SWAP C@ > LEAVE
  105.        THEN
  106.      LOOP DUP 0< IF
  107.        2DROP DROP R>
  108.      ELSE R> DROP
  109.      THEN
  110.    ELSE 2DROP R>
  111.    THEN ;
  112.  
  113. \ S+ STR$ STRING-ARRAY                                06Nov83RSW
  114.  
  115. : S+
  116.    >R OVER R@ + OVER 2- C@ MIN OVER OVER
  117.    SWAP 1- C! R> 1+ 255 MID$ SUB! ;
  118.  
  119. : STR$
  120.    SWAP OVER DABS
  121.    <# #S ROT SIGN #> ;
  122.  
  123. : STRING-ARRAY
  124.    CREATE 0 DO
  125.        DUP C, 0 C, DUP ALLOT
  126.      LOOP
  127.    DOES>
  128.      DUP C@ 2+ ROT * + 1+ COUNT ;
  129. : IN$                           \                     06Nov83RSW
  130.    DUP 4 PICK - DUP 0> IF
  131.      SWAP OVER - IF
  132.        0 SWAP 2+ 1 DO
  133.          DROP 3 PICK C@ OVER C@ = IF
  134.            3 PICK 3 PICK 3 PICK OVER S= IF
  135.              I LEAVE
  136.            ELSE 1+ 0
  137.            THEN
  138.          ELSE 1+ 0
  139.          THEN
  140.        LOOP
  141.      ELSE DROP 0
  142.      THEN >R 2DROP DROP R>
  143.    ELSE DROP S=
  144.    THEN ;
  145. \ GET$ INPUT$ GET INPUT                               06Nov83RSW
  146.  
  147. : GET$
  148.     PAD 1+ DUP ROT EXPECT FLEN PAD C! PAD COUNT ;
  149.  
  150. : INPUT$
  151.     50 GET$ ;
  152.  
  153. : GET
  154.     GET$ VAL ;
  155.  
  156. : INPUT
  157.     50 GET ;
  158.  
  159.  
  160.  
  161. \ RECLEN FCBLEN DBUFSIZE FCB - DOS file interface     16Nov83RSW
  162.         FORTH DEFINITIONS DECIMAL
  163.  
  164. 128 CONSTANT RECLEN     \ DOS disk file record length
  165.  
  166. 37 CONSTANT FCBLEN      \ DOS file control block length
  167.  
  168. RECLEN FCBLEN + CONSTANT DBUFSIZE  \ total FCB&data buffer size
  169.  
  170. : FCB  ( usage "FCB fcb-name" ) \ builds file control block
  171.    CREATE
  172.         HERE  DBUFSIZE ERASE  DBUFSIZE ALLOT
  173.    DOES> ;
  174.  
  175.  
  176.  
  177. \ DSKADR@ SETDMA FILEOP FILEOP2 - DOS file interface  15Nov83RSW
  178. : DSKADR@  ( fcb-addr -- disk-data-addr )
  179.    FCBLEN + ;       \ fetch address of corresponding data buffer
  180.  
  181. : SETDMA   ( fcb-addr -- )   \ set up disk file transfer address
  182.    26 SWAP  ( function-code fcb-addr -- )
  183.    DSKADR@  ( function-code disk-data-addr -- )
  184.    SYSCALL DROP ; \ do DOS function & drop status
  185.  
  186. : FILEOP  ( fcb-addr dos-function-code -- DOS-file-status )
  187.    SWAP SYSCALL 255 AND ;  ( normally 0 for no error )
  188. : FILEOP2  FILEOP DUP 0= IF \ do file operation - error?
  189.      DROP DSKADR@           \  no - return start of data address
  190.    ELSE
  191.      SWAP DROP              \  yes - return error code
  192.    THEN ;
  193. \ CLOSEF SEARCHF NEXTF KILLF READF WRITEF - DOS file  16Nov83RSW
  194. : OPENF  ( fcb-addr -- status )  \ open an existing file
  195.     DUP 15 FILEOP             \ do DOS file open
  196.     SWAP 14 + RECLEN SWAP ! ; \ set record length into fcb
  197. : CLOSEF    16 FILEOP ; \ close file after writing
  198. : SEARCHF   17 FILEOP ; \ search directory for a file
  199. : NEXTF     18 FILEOP ; \ search directory for next file
  200. : KILLF     19 FILEOP ; \ wipe out mention of a file
  201.  
  202. : READF  ( fcb-addr -- data-addr/error) \ read next file record
  203.     DUP DUP SETDMA       \ set up data transfer address
  204.     20 FILEOP2 ;         \ read next record.  4 < is an error
  205.  
  206. : WRITEF ( fcb-addr -- data-addr/error) \ write next file record
  207.     DUP DUP SETDMA       \ set up data transfer address
  208.     21 FILEOP2 ;         \ write next record   3 < is an error
  209. \ CREATEF RENAMEF FILEOP3 READFR WRITEFR - DOS file   14Nov83RSW
  210. : CREATEF ( fcb-addr -- status) \ create a new flie
  211.     DUP 22 FILEOP               \ do DOS file creation
  212.     SWAP 14 + RECLEN SWAP ! ;   \ set record length into fcb
  213. : RENAMEF      ( fcb-addr -- status ) \ rename a file
  214.     23 FILEOP ; ( NOTE: new name at fcb-addr+17 )
  215.  
  216. : FILEOP3  OVER 33 + !  DUP DUP SETDMA ;
  217.  
  218. : READFR  ( fcb-addr record-number -- data-addr/error )
  219.     FILEOP3             \ prepare for random file operation
  220.     33 FILEOP2 ;        \ read a record randomly
  221.  
  222. : WRITEFR  ( fcb-addr record-number -- data-addr/error )
  223.     FILEOP3             \ prepare for random file operation
  224.     34 FILEOP2 ;        \ write a record randomly
  225. \ DO-TYPE  last part of PREP-FCB - DOS file interface 15Nov83RSW
  226.  
  227. : DO-TYPE
  228.     DUP C@ ASCII . = IF         \ file type specified?
  229.       SWAP 8 + SWAP 1+          \  yes - fetch it
  230.       3 0 DO
  231.         DUP C@ DUP ASCII ! < IF \ end of file type?
  232.           DROP LEAVE            \  yes - move on
  233.         ELSE
  234.           3 PICK I + C! 1+      \  no - move type char into fcb
  235.         THEN
  236.       LOOP
  237.     THEN
  238.     DROP 5 +  ( fcb-addr+14 -- )
  239.     RECLEN SWAP ! ;             \ set up record length & exit
  240.  
  241. \ PREP-FCB   DOS file interface cont                  15Nov83RSW
  242. : PREP-FCB   ( fcb-addr filename-addr -- )
  243.     OVER DUP FCBLEN ERASE 1+ 11 BLANK \ null&blank out fcb&buff
  244.     DUP 1+ C@ ASCII : = IF            \ drive specifier?
  245.       DUP C@ ASCII @ -                \  yes - fetch as binary #
  246.       1 MAX 2 MIN 3 PICK C! 2+        \ store only valid range
  247.     THEN         ( fcb-addr filename-addr -- )
  248.     SWAP 1+ SWAP
  249.     8 0 DO                            \ move name char into fcb
  250.       DUP C@ DUP ( fcb-addr+1 filename-addr char char -- )
  251.       ASCII . = OVER ASCII ! < OR IF  \ name field terminator?
  252.         DROP LEAVE                    \  yes - move on
  253.       ELSE
  254.         3 PICK I + C! 1+              \  no - store name char
  255.       THEN
  256.     LOOP   DO-TYPE ;
  257. \ FCTRLZ  truncates string at any control-Z            7Nov83RSW
  258.         FORTH DEFINITIONS DECIMAL
  259. 1 STRING EOF  26 CHR$ EOF S!    \ define end-of-file string char
  260.  
  261. : FCTRLZ         ( addr1 len1 --- )
  262.    EOF           ( addr1 len1 addr2 len2 --- )
  263.    4 PICK 4 ROLL ( addr1 addr2 len2 addr1 len1 --- )
  264.    IN$           ( addr1 npos --- )
  265.    ?DUP 0> IF    ( addr1 ?npos --- )    \ any EOF's?
  266.      1- SWAP 1-  ( npos-1 addr1-1 --- )
  267.      C!                                 \  yes - truncate length
  268.    ELSE
  269.      DROP
  270.    THEN ;
  271.  
  272.  
  273. \ FILE1 SEE1  test DOS disk file interface            16Nov83RSW
  274.         FORTH DEFINITIONS DECIMAL
  275. FCB FILE1
  276. RECLEN STRING OBUF
  277. : SEE1          \ define & display FILE1
  278.     FILE1 CR ." file to display? " INPUT$ DROP PREP-FCB
  279.     CR FILE1 OPENF 255 = IF
  280.       ." can't open file " ABORT
  281.     THEN
  282.     BEGIN
  283.       FILE1 READF DUP 3 >
  284.     WHILE
  285.       RECLEN OBUF S! OBUF FCTRLZ OBUF TYPE  \ process file data
  286.     REPEAT
  287.     DROP FILE1 CLOSEF 255 = IF CR ." close error"
  288.     BEEP BEEP THEN QUIT ;
  289. \ screens to DOS file variables & constants           15Nov83RSW
  290.         FORTH DEFINITIONS DECIMAL
  291. VARIABLE DSKPOS         \ char position in disk buffer
  292. VARIABLE FEND           \ end of DOS file flag
  293. VARIABLE CHARPOS        \ char position in line buffer
  294. 2 STRING CRLF 13 CHR$ CRLF S! 10 CHR$ CRLF S+ \ CR LF string
  295. 1 STRING TAB 9 CHR$ TAB S!      \ TAB string
  296. 8 CONSTANT TABMOD       \ TAB modulus
  297. VARIABLE SCRLIM         \ screen limit storage
  298. VARIABLE LINE-COMPRESS  \ line compression flag
  299. VARIABLE TAB-COMPRESS   \ tab compression flag
  300. VARIABLE SCRLINE        \ screen line #
  301. 16 CONSTANT LINE-SCR    \ lines per screen
  302. 9 STRING SCR-SEP        \ screen seperator string
  303. NULL$ SCR-SEP S!        \ initialize screen seperator string
  304. VARIABLE BLKADR         \ current block address pointer storage
  305. \ PUTLINE puts line into disk buff-scrns to DOS cont. 16Nov83RSW
  306.  
  307. : PUTLINE
  308.    ILINE LEN 0> IF                        \ any char in string?
  309.      0 CHARPOS ! BEGIN                    \  yes - doit
  310.        ILINE DROP CHARPOS @ + C@          \ fetch char from line
  311.        FILE1 DSKADR@ DSKPOS @ + C!        \ store char to dskbuf
  312.        1 DSKPOS +! DSKPOS @ RECLEN = IF   \ incr dskpos - full?
  313.          FILE1 WRITEF 3 < IF              \  yes-write disk buf
  314.            CR BEEP ABORT" disk full" THEN \    write error exit
  315.          0 DSKPOS !                       \ reset disk char pos
  316.        THEN
  317.        1 CHARPOS +!                       \ bump string char pos
  318.        CHARPOS @ ILINE LEN =  \ loop until char pos = string len
  319.      UNTIL
  320.    THEN ;
  321. \ COMPRESS spaces out of line buff-scrns to DOS cont.  8Nov83RSW
  322.  
  323. : COMPRESS
  324.         LINE-COMPRESS @ 0> IF   \ compression turned on ?
  325.           ILINE -TRAILING SWAP 1- C! \ yes - delete trail spaces
  326.           CRLF ILINE S+         \ add carriage-return linefeed
  327.           TAB-COMPRESS @ 0> IF  \ compress spaces to tabs?
  328.             1 DROP              \  yes - add tab compress here
  329.           THEN
  330.         THEN ;
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337. \ WRITE-OPEN    screens to DOS continued              15Nov83RSW
  338.  
  339.         \ warning - the filename string must end with a null !
  340.  
  341. : WRITE-OPEN           ( filename-str --- )
  342.    DROP DUP FILE1 SWAP ( filename-addr fcb filename-addr --- )
  343.    PREP-FCB            ( filename-addr --- )    \ prepare fcb
  344.    FILE1 KILLF DROP                \ kill any previous file
  345.    FILE1 SWAP PREP-FCB     ( --- ) \ re-prepare fcb
  346.    FILE1 CREATEF 255 = IF          \ open file - error ?
  347.      BEEP CR ABORT" can't make new file " \ yes - give up
  348.    THEN
  349.    0 DSKPOS !           \ intialize disk buffer offset pointer
  350.    ;
  351.  
  352.  
  353. \ FETCH-SCR FETCH-LINE screens to DOS continued        8Nov83RSW
  354.  
  355. : FETCH-SCR        \ fetches screen # stored in SCR into a BLOCK
  356.    SCR @ BLOCK           ( blk-addr --- )
  357.    BLKADR !              \ intialize block address storage
  358.    SCR-SEP ILINE S!      \ put screen seperator into line buffer
  359.    PUTLINE               \ write screen seperator to disk file
  360.    0 SCRLINE !           \ intialize screen line counter
  361.    1 SCR +! ;            \ update scr # to next screen
  362.  
  363. : FETCH-LINE      \ fetches line out of a block into line buffer
  364.    BLKADR @ C/L ILINE S!  \ fetch line into line buffer
  365.    C/L BLKADR +!          \ update buffer address to next line
  366.    1 SCRLINE +! ;         \ update line # to next line
  367.  
  368.  
  369. : SCRNS->DOS ( first-scr last-scr filename-str ---) \ 16Nov83RSW
  370.    WRITE-OPEN  SCRLIM !  SCR !        \ set up file & scr stuff
  371.    BEGIN  FETCH-SCR                   \ get next scr into block
  372.      BEGIN  FETCH-LINE                \ get next line from block
  373.        COMPRESS                       \ do any line compression
  374.        PUTLINE                        \ write line to DOS file
  375.        SCRLINE @ LINE-SCR =           \  till all scr lines done
  376.      UNTIL
  377.      SCR @ SCRLIM @ >                 \  till all scrns done
  378.    UNTIL
  379.    EOF ILINE S!  PUTLINE              \ put ^Z into DOS file
  380.    FILE1 WRITEF 3 < IF                \ write last part of file
  381.      BEEP CR ABORT" disk full" THEN
  382.    FILE1 CLOSEF 255 = IF              \ update DOS directory
  383.      BEEP CR ABORT" close error" THEN
  384.    CR ." screen(s) transfered OK " CR ;
  385. \ SEND-SCRNS transfers standard screens to DOS file    8Nov83RSW
  386.  
  387. 15 STRING OFILE$
  388.  
  389. : SEND-SCRNS
  390.    CR ." enter 1 to compress lines "
  391.      INPUT DROP LINE-COMPRESS !
  392.    CR ." enter 1 to compress spaces with tabs "
  393.      INPUT DROP TAB-COMPRESS !
  394.    CR ." first screen # ? " INPUT DROP
  395.    CR ." last screen # ? " INPUT DROP
  396.    CR ." desired DOS screen filename ? " INPUT$
  397.    OFILE$ S!
  398.    OFILE$ SCRNS->DOS ;
  399.  
  400.  
  401. \ PROC-CHAR process char into line buffer              9Nov83RSW
  402. : PROC-CHAR                ( char --- )
  403.      DUP 13 = IF                        \ carriage return?
  404.        DROP C/L CHARPOS @ -             \  yes-# blanks to write
  405.        ILINE DROP CHARPOS @ + SWAP BLANK \ write blanks
  406.        C/L CHARPOS !                    \ max char counter
  407.      ELSE
  408.        DUP 10 = IF                      \ linefeed?
  409.          DROP                           \  yes - skip
  410.        ELSE DUP 26 = IF                 \ end-of-file?
  411.            1 FEND ! DROP 13 MYSELF \ yes-set end & recurse a CR
  412.          ELSE                      \ no-store char & bump count
  413.            ILINE DROP CHARPOS @ + C!   1 CHARPOS +!
  414.          THEN
  415.        THEN
  416.      THEN ;
  417. \ GETLINE gets a screen line from DOS file buffer     16Nov83RSW
  418. : GETLINE
  419.    0 CHARPOS !                      \ initialize line char count
  420.    BEGIN
  421.      FILE1 DSKADR@ DSKPOS @ + C@        \ fetch file char
  422.      PROC-CHAR                          \ put char in line buff
  423.      1 DSKPOS +!                        \ bump disk buff pos
  424.      DSKPOS @ RECLEN = IF               \ finished disk buffer?
  425.        FILE1 READF 4 < IF               \  yes-read more - done
  426.          1 FEND !                       \    yes - set done flag
  427.          13 PROC-CHAR                   \         finish up line
  428.        THEN
  429.        0 DSKPOS !                       \ reset disk buff pos
  430.      THEN
  431.      CHARPOS @ C/L = FEND @ OR          \ till line or file done
  432.    UNTIL   C/L ILINE DROP 1- C! ;       \ set line length
  433. \ READ-OPEN    DOS to screens continued               16Nov83RSW
  434.         \ warning - the filename string must end with a null !
  435. : READ-OPEN            ( filename-str --- )
  436.    DROP FILE1 SWAP     ( fcb filename-addr --- )
  437.    PREP-FCB            ( --- )       \ prepare fcb
  438.    FILE1 OPENF 255 = IF              \ open file - error ?
  439.      BEEP CR ABORT" can't open file" \   yes - give up
  440.    THEN
  441.    FILE1 READF 4 < IF   \ get first record - none?
  442.      BEEP CR ABORT" null length file "     \   yes - give up
  443.    THEN
  444.    0 DSKPOS ! ;         \ intialize disk buffer offset pointer
  445.  
  446.  
  447.  
  448.  
  449. \ LINEPUT  NEXT-SCR    DOS to screens cont.           13Nov83RSW
  450.  
  451. : LINEPUT               ( --- )
  452.     ILINE DROP BLKADR @ C/L CMOVE \ put line buff in block buff
  453.     C/L BLKADR +!         \ update current block addr
  454.     ;
  455.  
  456. : NEXT-SCR
  457.     SCR @ BLOCK  ( blk-addr --- ) \ fetch next block
  458.     DUP BLKADR !                  \ intialize block address
  459.     UPDATE                        \ mark as modified
  460.     LINE-SCR C/L * BLANK          \ blank out block
  461.     1 SCR +!                      \ point to next screen
  462.     ;
  463.  
  464.  
  465. \ DOS->SCRNS  DOS file to FORTH screens transfer      11Nov83RSW
  466.  
  467. : DOS->SCRNS ( first-scr filename-str --- ) \
  468.   READ-OPEN SCR !  0 FEND ! \ open DOS file & set variables
  469.   BEGIN  NEXT-SCR       \ fetch next screen blk
  470.     LINE-SCR 0 DO       \ write appropiate # lines into scre
  471.       GETLINE           \ fetch line out of file buffer
  472.       LINEPUT           \ put line into block buffer
  473.       FEND @ IF         \ found DOS file end?
  474.         LEAVE           \  yes - exit now
  475.       THEN
  476.     LOOP
  477.     FEND @              \  till DOS file end
  478.   UNTIL
  479.   FLUSH CR ." finished. Last screen was "
  480.   SCR @ 1 - DUP SCR ! . CR ;
  481. \ GET-SCRNS transfers DOS file to standard screens    10Nov83RSW
  482.  
  483. : GET-SCRNS
  484.    CR ." first screen # ? " INPUT DROP
  485.    CR ." desired DOS screen filename ? " INPUT$
  486.    OFILE$ S!
  487.    OFILE$ DOS->SCRNS ;
  488.  
  489.  
  490.  
  491.  
  492.  
  493.  
  494.  
  495.  
  496.  
  497. \ DOSTEST     DOS file to FORTH screens transfer      13Nov83RSW
  498.  
  499. : DOSTEST    ( first-scr filename-str --- ) \
  500.   READ-OPEN SCR !  0 FEND ! \ open DOS file & set variables
  501.   BEGIN  NEXT-SCR       \ fetch next screen blk
  502.     LINE-SCR 0 DO       \ write appropiate # lines into scre
  503.       GETLINE CR ILINE TYPE  \ fetch line out of file buffer
  504.       LINEPUT           \ put line into block buffer
  505.       FEND @ IF         \ found DOS file end?
  506.         LEAVE           \  yes - exit now
  507.       THEN
  508.     LOOP        FLUSH
  509.     FEND @              \  till DOS file end
  510.   UNTIL
  511.   FLUSH CR ." finished. Last screen was "
  512.   SCR @ 1 - DUP SCR ! . CR ;
  513.    FEND @              \  till DOS file end
  514.   UNTIL
  515.   FLUSH CR ." finished. La